home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / bin / instmodsh < prev    next >
Text File  |  2006-05-02  |  4KB  |  158 lines
  1. #!/usr/bin/perl -w
  2.  
  3. eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
  4.     if 0; # not running under some shell
  5.  
  6. use strict;
  7. use IO::File;
  8. use ExtUtils::Packlist;
  9. use ExtUtils::Installed;
  10.  
  11. use vars qw($Inst @Modules);
  12.  
  13.  
  14. =head1 NAME
  15.  
  16. instmodsh - A shell to examine installed modules
  17.  
  18. =head1 SYNOPSIS
  19.  
  20.     instmodsh
  21.  
  22. =head1 DESCRIPTION
  23.  
  24. A little interface to ExtUtils::Installed to examine installed modules,
  25. validate your packlists and even create a tarball from an installed module.
  26.  
  27. =cut
  28.  
  29.  
  30. sub do_module($)
  31. {
  32. my ($module) = @_;
  33. my $help = <<EOF;
  34. Available commands are:
  35.    f [all|prog|doc]   - List installed files of a given type
  36.    d [all|prog|doc]   - List the directories used by a module
  37.    v                  - Validate the .packlist - check for missing files
  38.    t <tarfile>        - Create a tar archive of the module
  39.    q                  - Quit the module
  40. EOF
  41. print($help);
  42. while (1)
  43.    {
  44.    print("$module cmd? ");
  45.    my $reply = <STDIN>; chomp($reply);
  46.    CASE:
  47.       {
  48.       $reply =~ /^f\s*/ and do
  49.          {
  50.          my $class = (split(' ', $reply))[1];
  51.          $class = 'all' if (! $class);
  52.          my @files;
  53.          if (eval { @files = $Inst->files($module, $class); })
  54.             {
  55.             print("$class files in $module are:\n   ",
  56.                   join("\n   ", @files), "\n");
  57.             last CASE;
  58.             }
  59.          else
  60.             { print($@); }
  61.          };
  62.       $reply =~ /^d\s*/ and do
  63.          {
  64.          my $class = (split(' ', $reply))[1];
  65.          $class = 'all' if (! $class);
  66.          my @dirs;
  67.          if (eval { @dirs = $Inst->directories($module, $class); })
  68.             {
  69.             print("$class directories in $module are:\n   ",
  70.                   join("\n   ", @dirs), "\n");
  71.             last CASE;
  72.             }
  73.          else
  74.             { print($@); }
  75.          };
  76.       $reply =~ /^t\s*/ and do
  77.          {
  78.          my $file = (split(' ', $reply))[1];
  79.          my $tmp = "/tmp/inst.$$";
  80.          if (my $fh = IO::File->new($tmp, "w"))
  81.             {
  82.             $fh->print(join("\n", $Inst->files($module)));
  83.             $fh->close();
  84.             system("tar cvf $file -I $tmp");
  85.             unlink($tmp);
  86.             last CASE;
  87.             }
  88.          else { print("Can't open $file: $!\n"); }
  89.          last CASE;
  90.          };
  91.       $reply eq 'v' and do
  92.          {
  93.          if (my @missing = $Inst->validate($module))
  94.             {
  95.             print("Files missing from $module are:\n   ",
  96.                   join("\n   ", @missing), "\n");
  97.             }
  98.          else
  99.             {
  100.             print("$module has no missing files\n");
  101.             }
  102.          last CASE;
  103.          };
  104.       $reply eq 'q' and do
  105.          {
  106.          return;
  107.          };
  108.       # Default
  109.          print($help);
  110.       }
  111.    }
  112. }
  113.  
  114. ################################################################################
  115.  
  116. sub toplevel()
  117. {
  118. my $help = <<EOF;
  119. Available commands are:
  120.    l            - List all installed modules
  121.    m <module>   - Select a module
  122.    q            - Quit the program
  123. EOF
  124. print($help);
  125. while (1)
  126.    {
  127.    print("cmd? ");
  128.    my $reply = <STDIN>; chomp($reply);
  129.    CASE:
  130.       {
  131.       $reply eq 'l' and do
  132.          {
  133.          print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
  134.          last CASE;
  135.          };
  136.       $reply =~ /^m\s+/ and do
  137.          {
  138.          do_module((split(' ', $reply))[1]);
  139.          last CASE;
  140.          };
  141.       $reply eq 'q' and do
  142.          {
  143.          exit(0);
  144.          };
  145.       # Default
  146.          print($help);
  147.       }
  148.    }
  149. }
  150.  
  151. ################################################################################
  152.  
  153. $Inst = ExtUtils::Installed->new();
  154. @Modules = $Inst->modules();
  155. toplevel();
  156.  
  157. ################################################################################
  158.